home *** CD-ROM | disk | FTP | other *** search
Visual Basic class definition | 1996-12-23 | 12.1 KB | 292 lines
VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "Queue" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = True Attribute VB_Description = "Provides an interface for clients to submit Service Requests." Option Explicit '------------------------------------------------------------------------- 'The Class is public, creatable, multi-use. It is provide as an OLE interface 'for the Client applications to call, adding Service Requests to the Queue '------------------------------------------------------------------------- Public Enum APECallbackNotificationConstants apeCallbackModeNone = giNO_CALLBACK apeCallbackModeRegisterEveryRequest = giUSE_PASSED_CALLBACK apeCallbackModeRegisterOnce = giUSE_DEFAULT_CALLBACK apeCallbackModeUseRaiseEvent = giRETURN_BY_SYNC_EVENT End Enum Private moDefaultCallback As APEInterfaces.Client 'See DefaultCallback property comments Private moEventObject As aeexpediter.EventReturn Private mbHaveEventObject As Boolean '****************** 'Public Properties '****************** Public Property Set DefaultCallBack(ByVal oCallback As APEInterfaces.Client) Attribute DefaultCallBack.VB_Description = "Set the callback object to use when apeCallbackModeRegisterOnce is passed to the Add method as the callback mode." '------------------------------------------------------------------------- 'Purpose: The property allows a client to set a default ' callback specific to the Queue class object ' that is referenced by the client. By setting ' this property a client can omit the CallBack parameter ' of the Queue.Add method and QueueMgr will use ' the default callback if a call back is required 'In: ' [oCallback] ' Must be a valid callback object having a callback method 'Effects: ' [moDefaultCallback] ' Class level variable is set equal to the passed object '------------------------------------------------------------------------- If oCallback Is Nothing Then Err.Raise giINVALID_CALLBACK + vbObjectError, Err.Source, LoadResString(giINVALID_CALLBACK) Set moDefaultCallback = oCallback End Property Public Property Get DefaultCallBack() As APEInterfaces.Client Set DefaultCallBack = moDefaultCallback End Property '***************** 'Public Methods '***************** Public Function Add(ByVal sCommand As String, ByVal iCallBackMode As APECallbackNotificationConstants, Optional ByVal vData As Variant, Optional ByVal CallBack As APEInterfaces.Client) As Long Attribute Add.VB_Description = "Adds a Service Request to be delegated by the AEQueueMgr." '------------------------------------------------------------------------- 'Purpose: Called by client Applications to add a Service request to the ' Queue. 'IN: ' [sCommand] ' The string that will be given to a worker with the passed data ' The worker uses this string to determine what OLE Server to ' use as a Service provider. Part of the string is passed to the ' Service provider from the Worker. ' [iCallBackMode] ' Defines if and how data is returned to client calling this function ' [vData] ' (Optional) Variant data that will be given to the Worker also. ' The Worker and the QueueMgr do not know what type of data this is ' The Worker will just pass it the the Service provider ' [Callback] ' (Optional) Callback object. If present, it will be immediately passed ' to the Expediter. The expediter will use it to callback ' delivering results that the Worker gives to it 'Return: A long that will be used as a Service Request ID. This ID is passed ' to the Worker to keep track of the Service results, the expediter ' so it can match the callback object to the Service results. The ' Expediter passes it to the client, too. So it can match the Callback ' with the type of callbacks it expected. 'Effects: ' The Expediter will get called if a Callback is passed or bUseDefaultCallback ' is true ' [gbBusyAdding] ' is true during this procedure ' [gcQueue] ' will get a clsService class object, storing the Service request ' information. 'Assumptions: ' [gcQueue] ' Is a valid collection object '------------------------------------------------------------------------- Dim oService As clsService 'clsService class object which is filled 'with Service request data and added to collection Dim bDataPresent As Boolean 'Flag that data is present Dim oCallback As APEInterfaces.Client 'Callback object that will be passed to Expediter Dim lID As Long 'ID that will be returned and passed to 'Expediter and given to Worker Dim lCount As Long 'gcQueue.count On Error GoTo AddError 'Exit sub if Stopping Queue If gbStopTest Then Exit Function gbBusyAdding = True 'Check if the QueueMgr is too busy to process request If gcQueue.Count >= glMaxQueueSize Then Err.Raise giQUEUE_MGR_IS_BUSY 'Check if data was passed If IsMissing(vData) Then bDataPresent = False Else bDataPresent = True 'Validate that the Expediter was created successfully If iCallBackMode <> giNO_CALLBACK Then If gbFailedToCreateExpediter Then Err.Raise giCOULD_NOT_CREATE_EXPEDITER End If 'Validate callback object Select Case iCallBackMode Case giUSE_PASSED_CALLBACK If CallBack Is Nothing Then Err.Raise giINVALID_CALLBACK Else Set oCallback = CallBack End If Case giUSE_DEFAULT_CALLBACK If moDefaultCallback Is Nothing Then Err.Raise giINVALID_CALLBACK Else Set oCallback = moDefaultCallback End If Case giRETURN_BY_SYNC_EVENT If Not mbHaveEventObject Then Err.Raise giFIRST_GET_WITHEVENTS_OBJECT End Select 'Iterate count of this method call glAddCallCount = glAddCallCount + 1 'Update U/I if form is visible If gbShow Then frmQueueMgr.lblCount = glAddCallCount Set oService = New clsService 'Generate ServiceID 'If ID is to large for Long start over glLastID = glLastID + 1 lID = glLastID LogEvent giADD_RECEIVED, glLastID 'Create the put the Service request values 'in the clsService object With oService .ID = lID .Command = sCommand .CallBackMode = iCallBackMode Select Case iCallBackMode Case giUSE_PASSED_CALLBACK, giUSE_DEFAULT_CALLBACK Set .CallBack = oCallback Case giRETURN_BY_SYNC_EVENT Set .EventObject = moEventObject End Select .DataPresent = bDataPresent 'Check what data type vData return is 'in order to determine how to handle it If bDataPresent Then Select Case VarType(vData) Case vbEmpty, vbNull .Data = Null Case vbObject, vbError, vbDataObject Set .Data = vData Case Else .Data = vData End Select End If End With 'Add oService to Queue using ID as Key gcQueue.Add oService, CStr(lID) 'Display stats lCount = gcQueue.Count If gbShow Then frmQueueMgr.lblQueue = lCount If lCount > glPeakQueueSize Then glPeakQueueSize = lCount If gbShow Then frmQueueMgr.lblPeak = glPeakQueueSize End If Add = lID If gbStopTest And Not gbBusyGetServiceRequest And Not gbBusyGetServiceResults Then StopQueue 'Flip the status flag right before the calling client is released 'A worker should not be allowed to take an activity request 'until the client is released. This keeps the the expediter 'from calling the client with Service results before the client 'is released with the return value, the Service ID oService.Status = giWAITING_FOR_WORKER Set oService = Nothing gbBusyAdding = False Exit Function AddError: Select Case Err.Number Case giQUEUE_MGR_IS_BUSY gbBusyAdding = False Err.Raise Err.Number + vbObjectError, Err.Source, LoadResString(Err.Number) Exit Function Case Is > giERROR_THRESHOLD LogError Err, 0 gbBusyAdding = False Err.Raise Err.Number + vbObjectError, Err.Source, LoadResString(Err.Number) Exit Function Case RPC_E_CALL_REJECTED 'Collision error, the OLE server is busy Dim iRetry As Integer Dim il As Integer Dim ir As Integer 'First check for stop test If gbStopTest And Not gbBusyGetServiceRequest Then StopQueue: Exit Function If iRetry < giMAX_ALLOWED_RETRIES Then iRetry = iRetry + 1 ir = Int((giRETRY_WAIT_MAX - giRETRY_WAIT_MIN + 1) * Rnd + giRETRY_WAIT_MIN) For il = 0 To ir DoEvents Next il LogEvent giCALL_REJECTED_RETRY, lID Resume Else 'We reached our max retries LogError Err, lID gbBusyAdding = False Err.Raise Err.Number, Err.Source, Err.Description End If Case ERR_DUPLICATE_KEY 'It seems that sometimes 'this procedure is executed more than once 'before glLastID is incremented. This cause 'an error when adding an object to the collection 'Generate ServiceID 'If ID is to large for Long start over If glLastID = glMAX_ID Then glLastID = 0 glLastID = glLastID + 1 lID = glLastID oService.ID = lID Resume Case giCOULD_NOT_CREATE_EXPEDITER LogError Err, lID gbBusyAdding = False Err.Raise giCOULD_NOT_CREATE_EXPEDITER + vbObjectError, Err.Source, LoadResString(giCOULD_NOT_CREATE_EXPEDITER) Case giFIRST_GET_WITHEVENTS_OBJECT LogError Err, lID gbBusyAdding = False Err.Raise giFIRST_GET_WITHEVENTS_OBJECT + vbObjectError, Err.Source, LoadResString(giFIRST_GET_WITHEVENTS_OBJECT) Case giINVALID_CALLBACK LogError Err, lID gbBusyAdding = False Err.Raise giINVALID_CALLBACK + vbObjectError, Err.Source, LoadResString(giINVALID_CALLBACK) Case ERR_OVER_FLOW LogError Err, lID If glAddCallCount = glMAX_ID Then glAddCallCount = 0 If glLastID = glMAX_ID Then glLastID = 0 Resume 'Can not be resume next because gllastid must be atleast 1 before 'lID is set equal to it Case Else LogError Err, lID gbBusyAdding = False Err.Raise Err.Number, Err.Source, Err.Description Exit Function End Select End Function Public Function GetEventObject() As aeexpediter.EventReturn Attribute GetEventObject.VB_Description = "Returns the event source object that a client must respond to when apeCallbackModeUseRaiseEvent is passed to the Add method as the callback mode." If Not mbHaveEventObject Then Set moEventObject = goExpediter.GetEventObject mbHaveEventObject = True End If Set GetEventObject = moEventObject End Function '******************* 'Private methods '******************* Private Sub Class_Initialize() CountInitialize End Sub Private Sub Class_Terminate() CountTerminate End Sub 
